(*$S2000*)
(*foo program DVITYP (dvi:-,output:+);*)
program DVITYP (dvi*,output);
(* Read, process, check and print a DVI file *)
(* fix--
	tty->output in error routine?.
	check for overflows before changing V and H
	in general, identify sysdep features:
		tfm opening, random reading,
		record layouts, junks
*)

LABEL	1, (* go here for second pass *)
	9; (* go here for abort *)

CONST
	(* a few adjustable compile time constants *)
	LOWASC=0; HIASC=127;	(* for ASCII characters *)
	LOWPRT=33; HIPRT=126;	(* for printing ASCII characters *)
	DVIID=1;		(* current ID byte for DVI files *)
	MAXF=63;		(* maximum font number allowed *)
	MAXS=200;		(* maximum stack depth *)
	MAXT=300;		(* amount of space in which to read tfm's *)
	MAXSTRLEN=100;		(* max length of font names, etc *)
	tab = '   ';

	(* constant constants *)
	ptperin=72.27;		(* TEX's idea of points per inch *)
	rsuperin=254000;	(* RSU's per inch -- 1rsu=10↑-7 meter *)
	fixperpt=1048576;	(* FIX's per point -- 1pt=2↑20fix *)

(*foo*)	texsys=-133207140615b; 	(* TEX,SYS ppn for font info *)

	(* The DVI commands *)
		(* VERTCHAR 0 through 127 *)
		NOP=128; BOP=129; EOP=130; PST=131;
		PUSH=132; POP=133;
		VERTRULE=134; HORZRULE=135; HORZCHAR=136; FONT=137;
		W4=138; W3=139; W2=140; W0=141;
		X4=142; X3=143; X2=144; X0=145;
		Y4=146; Y3=147; Y2=148; Y0=149;
		Z4=150; Z3=151; Z2=152; Z0=153;
		FONTNUM=154 (* through 217 *);

TYPE
	(* here we disect words into bytes *)
	eightbit=0..255;
	sixteenbit=0..65535;
	oneofthree=1..3;
	hack=packed record
		case oneofthree of
		1:(	word: integer);
		2:(	leftsixteen:sixteenbit;
			rightsixteen:sixteenbit;
		   	junka:0..15);
		3:(	byte0:eightbit;
			byte1:eightbit;
			byte2:eightbit;
			byte3:eightbit;
			junkb:0..15);
		end;

	(* strings of characters are done thusly: *)
	ascii= LOWASC..HIASC;
	str=record
		len: integer;
		let: packed array[1..MAXSTRLEN] of ascii;
		end;

	(* to hold the contents of a tfm file: *)
	tfmholder=array[0..MAXT] of hack;

VAR

(*foo*)	tfmfile: packed file of integer;
(*foo*) fooname: packed array[1..9] of char;

(* Variables associated with the DVI file *)

dvi:	file of integer;
dviw:		hack;	(* current 32-bit word from dvi file *)
dvibytecnt,		(* number of the byte that GETB last returned *)
dvilen,			(* number of bytes in DVI file (for half pass) *)
pstptr,			(* byte number of the PST command *)
dvicmd:		integer;(* the current command being processed *)
foundpst:	boolean;(* true when we've gotten to the PST command *)
height, width,		(* for heights and widths of chars and rules *)
charno:		integer;(* for character number of Horzchar cmd *)

(* constants from the postamble *)

magnify,		(* overall magnification for the DVI file
				(only reflected in second pass output) *)
overridemag,		(* user requested over-ride for magnify  *)
maxh, maxw: integer;	(* maximum page height and width *)
multiplier, divider, idbyte, junkbyte: integer;

(* dvi variables *)

f,		(* current font number *)
h,		(* current v-coordinate *)
v,		(* current h-coordinate *)
wamt,		(* current w-amount *)
xamt,		(* current x-amount *)
yamt,		(* current y-amount *)
zamt,		(* current z-amount *)
top:integer;	(* top-of stack pointer *)

hstack,	(* and all of the stacks *)
vstack,
wstack,
xstack,
ystack,
zstack
: array[1..MAXS] of integer;

thispageptr,		(* byte number of this page's BOP command *)
lastpageptr,		(* byte number of last page's BOP command *)
checkpageptr: integer;	(* page pointer in BOP or PST, should=lastpageptr *)
expectbop:   boolean;	(* true when the next command must be BOP
			   (or NOP or PST) , which is right after an EOP,
			   and at the beginning of a DVI file. *)
eofok: boolean;		(* true iff we are expecting the DVI file to end,
			   which is only after we have gotten to the
			   223-bytes at the end of the postamble *)
kount: array[0..9] of integer;



twopass,		(* true iff user wants two (or 1-1/2) pass operation *)
halfpass,		(* true during short (jump to postamble) first pass *)
firstpass,		(* true on first (short or regular) pass *)
secondpass,		(* true on second pass *)
printing,		(* true when full results should be printed *)
terse:			(* false to print fully on second pass, true for
				just characters and their locations *)
	boolean;

(* Variables associated with units, printing and converting *)
units:		str;	(* the name of the units we are using; one of: *)
meter,cm,pt,		(* the names of the different units *)
inch,rsu:	str;
convert:	real;	(* there are 'convert'-many 'units' in an RSU *)
dp:		integer;(* number of decimal places WriteReal prints *)

(* 0 Mode control *)
    (* This mode is for use to produce a condensed, quick and dirty reporting
    in spite of all errors. It is initiated by replying to the pass
    information request with 0.  VERTCHAR commands are represented simply by
    the letter involved, with normal text being typed as a continuous string of
    characters, with W and X commands (or several such comands) represented by a
    single space. On the appearance of a Y or Z commnd a carriage return will be
    issued.  This command and any additional non-VERTCHAR commands will then
    be shown on the next line until the apearance of the next VERTCHAR which will
    again start a new line. Any unrecognized or illegal byte appearing in the
    text will be printed on a separate line.
    *)

(* Printing control *)
	(* In 'single pass' operation, this program will print the DVI file
	from start to finish, pretty much mnemonically.  Each DVI command
	will be printed on a seperate line, along with its paramaters.
	The program will check the validity of paramaters to the extent
	possible (it checks back pointers for correctness, that EOPs are
	followed by BOP's or PST, etc.).  It will also print (paranthetically)
	any helpfull implied paramaters that it can (it keeps track of wamt,
	so it can tell you how far a W0 command should move; it even keeps
	all the stacks, so it can tell you how far a Y0 should move even
	after a number of PUSHes and POPs.)  To get this mode, just answer
	the 'how many passes?' question '1'.  (If the program finds any
	errors in the DVI file, it will print a diagnostic error message,
	and give the user the chance to continue or abort the run.)
	You will also get to answer a question about 'units'.  You can
	have all distances from the DVI file printed in Points, Inches,
	Centimeters, Meters(?), or good old RSU's, by responding in the
	indicated fashion.

	If, however, the program can make a second pass over the DVI file
	(read it from start to finish, and then from start to finish again),
	then it can tell you lots more about the DVI file.  In fact, it can
	tell you exactly where each character and rule go on each page.  The
	reason that this requires a second pass is that there is some
	critical information in the postamble, without which it is impossible
	to figure out these things.  But the postamble is at the end of the
	DVI file, and there is no way to get to it except by reading through
	the whole DVI file.  What the postamble has that is so important is
	the names of all the fonts that the DVI file uses.  The program needs
	the font names so that it can read the proper TFM files, so as to
	find out the widths of all the characters.  We need to know the widths
	of the characters so that we know how far to move the H-COORDINATE
	after a VERTCHAR command.  Once we've read the postamble, and therefor
	know the name of all the fonts, we can start to read the DVI file
	again, this time keeping full track of exactly where the 'current
	position on the page' (i.e. H- and V-COORDINATEs) is.  To get this
	'two pass' operation, say '2' to the 'how many passes' question.
	There will be more questions to answer in this case.  DVI files
	have in their postambles the value of MAGNIFY that the TEX users
	have requested.  The value of MAGNIFY is taken into account during
	the second pass, and the user of this program is given a chance to
	override the value in the DVI file, to see what results that has.
	This program also allows the user to specify a TERSE second pass,
	in which case, it will only print out where each character and
	rule is printed on each page.  If TERSE is not selected, then all
	the DVI commands in the file are printed, and the user gets an
	informatory line before each DVI command that tells where the 'current
	position on the page' is.  In two pass operation, the user also
	gets to specify that the entire first pass not be printed (but
	the program will still check for all errors, and report any found).

	There is actually a bit of a lie above that should be cleared up.
	It {\sl is} actually possible to read the postamble without
	reading through the entire DVI file first.  But this is not a
	function that is available in standard PASCAL.  It is an extension
	to the language that may be included in the PASCAL compiler that
	you are using.  If so, then by modifying a few lines below (in the
	routines Dvibytecnt and Rand--maybe you can even leave them alone
	if you are using the 'P20' compiler of Charles Hedrick), you can
	get a kind of 'one-and-a-half' pass operation:  This program
	will jump to the end of the DVI file, read the postamble, then
	go back to the beginning, for a normal second pass.  To get this
	mode of operation, say '1' to the 'Jump to postamble?' question.

*)


(* Font related variables *)

fontname:	array[0..MAXF] of str;	(* holds font names from postamble *)
fontmag:	array[0..MAXF] of integer;	(* and their magnifications *)


fontused,				(* and whether they've been used 
						in the body of the DVI file *)
fontdefined:				(* and whether they've been defined 
						in the postamble *)
		array[0..MAXF] of boolean;

fontarea, fontext: str;			(* default directory and extension
						for tfm files *)

charwidth:				(* widths of chars in all fonts 
						from their tfm files *)
	array[0..MAXF,0..127] of integer;

widthloaded:				(* Is charwidth[i,*] valid? *)
	array[0..MAXF] of boolean;	(* i.e. have we read in the character
						widths for this font *)

(* temporaries *)
i: integer;




(* utility routines *)


(* returns the 'printing length' of an integer *)

function plen(i:integer):integer;
	var ans: integer;
	begin
	if i<0 then begin i:=0-i; ans:=1; end
	else ans:=0;
	repeat
		i:=i div 10;
		ans:=ans+1;
	until i=0;
	plen:=ans;
	end;
	

(* This routing prints out all possible error messages *)
	(* If the error number is negative, then the error is fatal
	(* otherwise, give the user the option of trying to continue.
	(* Be sure to change MAXE if you add error messages
	(* Don't you wish PASCAL let you pass constant strings? *)

procedure error(err,parm:integer);
	CONST MAXE=28; (* error numbers are in the range 1..MAXE *)
	var fatal:boolean; cont:integer;
	begin

	writeln(tty);

	if err>0 then fatal:=false
	else begin
		fatal:=true;
		err:=-err;
		write(tty,'FATAL ');
		end;
	writeln(tty,'DVITYP error (number ',err:plen(err),')');

	(* for the OUTPUT file *)
	writeln; writeln('ERROR ',err:plen(err)); writeln;

	if (0<err) and (err<=MAXE) then case err of
	1: writeln(tty,'DVI eof unexpectedly at byte number ',
					parm:plen(parm),'.');
	2: writeln(tty,'Font number ',parm:plen(parm),
			' not in range 0..',MAXF:plen(MAXF),', will use 0.');
	3: writeln(tty,'Final page pointer in postamble wrong, should be ',
							parm:plen(parm),'.');
	4: writeln(tty,'Font ',parm:plen(parm),' used and not defined.');
	5: writeln(tty,'Font ',parm:plen(parm),' defined twice.');
	6: begin
		writeln(tty,'TFM file larger than anticipated.');
		writeln(tty,' Recompile me with MAXT > ',parm:plen(parm),'.');
		end;
	7: writeln(tty,'Postamble back pointer wrong, should be ',
							parm:plen(parm),'.');
	8: writeln(tty,'All bytes at end of postamble must be 223, ',
					parm:plen(parm),' is illegal.');
	9: begin
		writeln(tty,'Found byte with value ',parm:plen(parm),
			' while looking backwards from EOF for DVI ID.');
		writeln(tty,' That''s not a 223, nor is it DVI ID (',
						DVIID:plen(DVIID),').');
		end;
	10: writeln(tty,'DVI ID should be ',DVIID:plen(DVIID),
			', not ',parm:plen(parm),'.');
	11: begin 
		writeln(tty,'Postamble backpointer points to a byte which is ',
						'not a PST command.');
		writeln(tty,' The byte pointed to has value ',
						parm:plen(parm),'.');
		writeln(tty,' Maybe you shouldn''t try jumping to the ',
				' postamble until this pointer is corrected.');
		end;
	12: begin
		writeln(tty,'First command after EOP should be BOP or PST;');
		writeln(tty,' instead found ',parm:plen(parm),'.');
		end;
	13: begin
		writeln(tty,'VERTCHAR',parm:plen(parm),' command occured ',
			' before any type of FONT command on this page.');
		writeln(tty,' Will use font 0.');
		end;
	14: writeln(tty,'Previous page pointer should be ',
				parm:plen(parm),'.');
	15: writeln(tty,'Stack not empty at EOP,',
				' it''s at level ',parm:plen(parm),'.');
	16: writeln(tty,'Character number in HORZCHAR is bigger than 127: ',
				parm:plen(parm),'; Will use 127.');
	17: begin
		writeln(tty,'HORZCHAR ',parm:plen(parm),' command occured ',
			' before any type of FONT command on this page.');
		writeln(tty,' Will use font 0.');
		end;
	18: begin
		writeln(tty,'Your DVI Stack is bigger than expected.');
		writeln(tty,' Recompile me with MAXS > ',parm:plen(parm),'.');
		writeln(tty,' Ignoring this PUSH.');
		end;
	19: begin
		writeln(tty,'More POPs than PUSHes encountered while ',
			'reading a page (\count0=',parm:plen(parm),').');
		writeln(tty,' Ignoring this POP');
		end;
	20: writeln(tty,'Undefined DVI command: ',parm:plen(parm),'.');
	21: begin
		writeln(tty,'First command in DVI file should be a BOP;');
		writeln(tty,' instead found: ',parm:plen(parm),'.');
		end;
	22: writeln(tty,'Postamble Multiplier is ',parm:plen(parm),
				' which isn''t > 0, will assume 1.');
	23: writeln(tty,'Postamble Divider is ',parm:plen(parm),
				' which isn''t > 0, will assume 1.');
	24: begin
		writeln(tty,'Font ',parm:plen(parm),' not defined ');
		writeln(tty,' in postamble, so using 0 for all its widths');
		end;
	25: begin
		writeln(tty,'Concatenated string would be longer than ',
			MAXSTRLEN:plen(MAXSTRLEN),
			' (probably while making a font file name).');
		writeln(tty,' Recompile me with MAXSTRLEN > ',parm:plen(parm));
		end;
	26: begin
		writeln(tty,'Font Name longer than ',
					MAXSTRLEN:plen(MAXSTRLEN),'.');
		writeln(tty,' Recompile me with MAXSTRLEN > ',parm:plen(parm));
		end;
	27: begin
		writeln(tty,'The character whose ORD is ',parm:plen(parm),
			' isn''t in the legal ascii range ',
			LOWASC:plen(LOWASC),'..',HIASC:plen(HIASC),'.');
		writeln(tty,' Will use ',chr(HIPRT),' instead.');
		end;
	28: begin
		writeln(tty,'Postamble Back Pointer (',parm:plen(parm),')');
		writeln(tty,' greater than number of last byte in DVI file (',
						dvilen-1:plen(dvilen-1),').');
		end;
	end (* of case *)
	else begin
		writeln(tty,'Bad error number in DVITYP! ',err:plen(err));
		fatal:=true;
		end;

	if fatal then writeln(tty,'Fatal error, quiting')
	else begin
		writeln(tty,'Continue? (0/1)');
		break(tty);
		repeat read(tty,cont) until (cont=0) or (cont=1);
		end;
	if fatal or (cont=0) then begin
		writeln; writeln('Quiting');
		goto 9;
		end;
	end;

(* write out an integer the right way *)
procedure writeint(int:integer);
	procedure wint(int:integer);
		begin
		if int>0 then begin
			wint(int div 10);
			write((int mod 10):1);
			end;
		end;
	begin
	if int=0 then write('0')
	else begin
		if int<0 then begin write('-'); int:=0-int; end;
		wint(int);
		end;
	end;

(* write out an octal number, almost the right way *)
procedure writeoct(oct:integer);
	var i:integer;
	procedure woct(oct:integer);
		begin
		if oct>0 then begin
			woct(oct div 8);
			write((oct mod 8):1);
			end;
		end;
	begin
	write('''');
	if oct=0 then write('0')
	else begin
		if oct<0 then begin
			write('-');
			oct:=-oct; (* small bug here, of oct=-MAXINT *)
			end;
		woct(oct);
		end;
	end;

(* write out a real number in a reasonable fashion *)
procedure writereal(r:real);
	var i:integer;
	begin
	if r<0 then begin r:=0.0-r; write('-'); end;
	if r=0.0 then begin
		write('0.');
		for i:=1 to dp do write('0');
		end
	else begin
		(* round it *)
		r:=r+0.0009;
		(* do integer part *)
		i:=trunc(r);
		writeint(i);
		(* do fractional part *)
		r:=r-i;
		write('.');
		for i:=1 to dp do begin
			r:=r*10;
			write(trunc(r):1);
			r:=r-trunc(r);
			end;
		end;
	end;

(* write out a character *)
procedure writechr(c:integer);
	begin
	if (LOWPRT<=c) and (c<=HIPRT) then write(chr(c))
	else writeoct(c);
	end;

(* write out a string *)
procedure writestr(s:str);
	var i:integer;
	begin
	for i:=1 to s.len do writechr(s.let[i]);
	end;

(* nondestructivly tack the second string onto the end of the first *)
procedure concat(var s:str; t: str);
	var i,reslen: integer;
	begin
	reslen:=t.len+s.len;
	if reslen>MAXSTRLEN then begin
		error(25,reslen);
		t.len:=MAXSTRLEN-s.len;
		reslen:=MAXSTRLEN; end;
	for i:=1 to t.len do
		s.let[s.len+i]:=t.let[i];
	s.len:=reslen;
	end;

(* for looking at tfm files--converts FIX's to RSU's *)
function unfix(f:integer):real;
	var h:hack; i:integer;
	begin
	h.word:=f;
	if h.leftsixteen<32768 then i:= h.leftsixteen*65536+h.rightsixteen
	else i:=(h.leftsixteen-65535)*65536+(h.rightsixteen-65536);
	unfix:=i/fixperpt; (* converts a FIX integer to a real number of pts *)
	end;

(* Gets the next byte in the DVI file, -1 if no more bytes and eofok *)
function getb:integer;
	var i: integer;
	begin
	dvibytecnt:=dvibytecnt+1;
	i:=dvibytecnt mod 4;
	case i of
		0:begin 
			if eof(dvi) then begin (* dvi↑ is invalid *)
				if not eofok then error(-1,dvibytecnt);
				getb:=-1;
				end
			else begin
				dviw.word:=dvi↑;
				get(dvi);
				getb:=dviw.byte0;
				end;
			end;
		1: getb:=dviw.byte1;
		2: getb:=dviw.byte2;
		3: getb:=dviw.byte3;
		end;
	end;

(* Finds out how many bytes are in the DVI file *)
function dvibytes:integer;
	begin
(*foo	setpos(dvi,-1); (* go to end of DVI file *)
(*foo	dvibytes:=4*curpos(dvi); (* return the current postion number *)
	end;

(* Does random access in DVI file such that next getb will get byte number n *)
procedure rand(n:integer);
	var word,byte: integer;
	begin
	word:=n div 4 ; (* figure which word the requested byte is in *)
(*foo	setpos(dvi,word) ; (* make it the next word to be read by wordin *)
	dvibytecnt:=word*4-1 ; (* fool getb into thinking the next byte it is
		to read is number word*4, so it will get a new word *)
	while dvibytecnt<n-1 do byte:=getb; (* skip unwanted bytes in word *)
	(* now the next getb will get byte number n *)
	end;
 
(* Read the next 2-byte dimension in the DVI file *)
function twobytes: integer;
	var n:integer;
	begin
	n:=getb;
	if n<128 then
		twobytes:=n*256+getb
	else begin
		twobytes:=(n-255)*256+(getb-256);
		end
	end;

(* Read the next 3-byte dimension in the DVI file *)
function threebytes: integer;
	var n:integer;
	begin
	n:=getb;
	if n<128 then begin
		n:=n*256+getb;
		threebytes:=n*256+getb;
		end
	else begin
		n:=(n-255)*256+(getb-255);
		threebytes:=n*256+(getb-256);
		end
	end;

(* Read the next 4-byte dimension in the DVI file *)
function fourbytes: integer;
	var n:integer;
	begin
	n:=getb;
	if n<128 then begin
		n:=n*256+getb;
		n:=n*256+getb;
		fourbytes:=n*256+getb;
		end
	else begin
		n:=(n-255)*256+(getb-255);
		n:=n*256+(getb-255);
		fourbytes:=n*256+(getb-256);
		end
	end;

(* Read the next 4-byte integer in the DVI file *)
function intin:integer;
	begin
	intin:=fourbytes;
	end;

(* get next ascii char from DVI file *)
function asciiin:ascii;
	var b: integer;
	begin
	b:=getb;
	if (b<LOWASC) or (b>HIASC) then begin
		error(27,b);
		asciiin:=HIPRT;
		end
	else asciiin:=b;
	end;

(* Print out a dimension *)
procedure writedimen(r:integer);
	begin
	writereal(convert*r);
	writestr(units);
	end;

(* print out the 'current position on the page' *)
procedure writeat;
	begin
	write('(at H='); writedimen(h);
	write(', V='); writedimen(v);
	write(')');
	end;


(* Do a W command *)
procedure wmove(wcmd, dist: integer); begin
	wamt:=dist;
	if printing then begin
		write('W',wcmd:1,' ');
		if wcmd=0 then write('('); 
		writedimen(wamt);
		if wcmd=0 then write(')');
		end;
	if secondpass then h:=h+wamt;
	end;

(* Do an X command *)
procedure xmove(xcmd, dist: integer); begin
	xamt:=dist;
	if printing then begin
		write('X',xcmd:1,' ');
		if xcmd=0 then write('(');
		writedimen(xamt);
		if xcmd=0 then write(')');
		end;
	if secondpass then h:=h+xamt;
	end;

(* Do a Y command *)
procedure ymove(ycmd, dist: integer); begin
	yamt:=dist;
	if printing then begin
		write('Y',ycmd:1,' ');
		if ycmd=0 then write('(');
		writedimen(yamt);
		if ycmd=0 then write(')');
		end;
	if secondpass then v:=v+yamt;
	end;

(* Do a Z command *)
procedure zmove(zcmd, dist: integer); begin
	zamt:=dist;
	if printing then begin
		write('Z',zcmd:1,' ');
		if zcmd=0 then write('(');
		writedimen(zamt);
		if zcmd=0 then write(')');
		end;
	if secondpass then v:=v+zamt;
	end;

(* read a font's tfm file into an array *)
	(* only reads through the width info *)
procedure readtfm(fntnam:str; var tfm:tfmholder);
	var
(*foo	tfmfile: packed file of integer;*)
	tfmname: str;			(* add extension to fntnam *)
	tempchr: packed array[1..MAXSTRLEN] of char;
					(* for stupid RESET command *)
	tfmsread: integer;		(* how many words to read *)
	lh,bc,ec,nw: integer;		(* first parms in tfm file *)
	needdirectory:boolean;		(* true iff font name needs to be
						augmented with a directory *)
	i:integer;
	begin

	(* Do some SYSDEP stuff to find the name of the TFM file
					associated with this font *)
	tfmname.len:=0;			(* make tfmname empty *)
	needdirectory:=true; i:=1;	(* see if font name has directory *)
	while (i<=fntnam.len) and needdirectory do
		begin
		if (fntnam.let[i]=ord(':')) or
		   (fntnam.let[i]=ord('<')) then
			needdirectory:=false;
		i:=i+1;
		end;

	(* construct the tfm file name *)
	if needdirectory then concat(tfmname,fontarea);
	concat(tfmname,fntnam);
	concat(tfmname,fontext);	(* Put '.TFM' on the end *)

	(* it would be nice to be able to do:
		reset(tfmfile,tfmname.let)
	   here, but we can't because of stupid pascal.
	   Instead, we have to put the fntnam in a char array: *)

	for i:=1 to tfmname.len do
		tempchr[i]:=chr(tfmname.let[i]);
	for i:=tfmname.len+1 to MAXSTRLEN do tempchr[i]:=' ';
(*foo	reset(tfmfile,tempchr);*)
(*foo*)for i:=1 to 9 do fooname[i]:=' ';
(*foo*)for i:=1 to min(fntnam.len,6) do begin
(*foo*)		fooname[i]:=chr(fntnam.let[i]);
(*foo*)		if fntnam.let[i]>96 then fooname[i]:=chr(fntnam.let[i]-32);
(*foo*)		end;
(*foo*)fooname[7]:='T'; fooname[8]:='F'; fooname[9]:='M';
(*foo*)reset(tfmfile,fooname,0,texsys);

	(* Get first 6 words in TFM file *)
	for i:=0 to 5 do begin
		tfm[i].word:=tfmfile↑;
		get(tfmfile);
		end;

	(* get some of the magic paramaters associated with the TFM file *)
	lh:=tfm[0].rightsixteen;
	bc:=tfm[1].leftsixteen;
	ec:=tfm[1].rightsixteen;
	nw:=tfm[2].leftsixteen;
	(* compute how much of the tfm file must be read to get the entire
	   FINFO and WIDTH arrays, then read them in *)
	tfmsread:=6+lh+(ec-bc+1)+nw;
	if tfmsread>MAXT then error(-6,tfmsread);
	for i:=6 to tfmsread do begin
		tfm[i].word:=tfmfile↑;
		get(tfmfile);
		end;
	end;


(* read a tfm file, filling in CHARWIDTH with the widths of the font's chars *)
procedure loadwidth(id:integer);
	var
	tfmname: str;			(* the name of the tfm file *)
	bc, ec, lh:integer;		(* directly from TFM file *)
	finfos: integer;		(* indexαof first FINFO in TFM *)
	widths: integer;		(* index of first WIDTH in TFM *)
	finfoloc,
	widthloc: integer;		(* index of this character's
						 FINFO and WIDTH indecies *)
	tfm:tfmholder;			(* holds tfm file *)
	rsuperfix: real;		(* font's 'AT-SIZE' in rsu's *)
	i:integer;
	begin

	(* save the fact that we've loaded this font's widths *)
	widthloaded[id]:=true;

	(* if this font was never mentioned in the postamble, we can't 
		read in its tfm file, so don't *)
	if not fontdefined[id] then begin
		error(24,id);
		for i:=0 to 127 do charwidth[id,i]:=0;
		end
	else begin
		(* go ahead and read in the tfm file, and compute charwidths *)
		readtfm(fontname[id],tfm);
		lh:=tfm[0].rightsixteen;
		bc:=tfm[1].leftsixteen;
		ec:=tfm[1].rightsixteen;
		finfos:=6+lh;
		widths:=finfos+ec-bc+1;

		(* figure out multiplier to convert from FIXes to RSUs *)
		rsuperfix:=unfix(tfm[7].word)*(fontmag[id]/1000)
					(* thats in points, so... *)
			*(rsuperin/ptperin)
					(* correct for multipli/divider *)
			*(divider/multiplier);

		(* writeln;
		   writeln('loading font ',id:plen(id));
		   writeln('designsize ',unfix(tfm[7].word));
		   writeln('fontmag ',fontmag[id]/1000);
		   write('rsuperfix ',rsuperfix);
		   writeln;
		*)

		(* now fill in the charwidth array *)
		for i:=0 to bc-1 do charwidth[id,i]:=0;
		for i:=bc to ec do begin
			finfoloc:=finfos+i-bc;
			widthloc:=widths+tfm[finfoloc].byte0;
			charwidth[id,i]:=trunc(rsuperfix
						*unfix(tfm[widthloc].word));

			(*
			   write('charwidth[',id:plen(id),',',i:4,']=');
			   writedimen(charwidth[id,i]); writeln;
			*)
			end;
		for i:=ec+1 to 127 do charwidth[id,i]:=0;
		end;
	end;

(* common code for FONT and FONTNUM commands *)
procedure touchfont(fnt: integer); begin
	if printing then writeint(fnt);
	if (fnt>MAXF) or (fnt<0) then error(2,fnt)
	else f:=fnt;
	(* if we'll be needing this font's charwidths, load them in *)
	if secondpass and not widthloaded[f] then loadwidth(f);
	if secondpass and printing then begin
		write(' ('); writestr(fontname[f]);
		write(' mag ');	writeint(fontmag[f]); write(')'); end;
	fontused[f]:=true;
	end;

(* this procedure unlocks the mysteries of the postamble *)
procedure readpostamble;  
	var namelen, extralen, cksum, id, i
			: integer; (* help read in fontdefs *)
	begin
	(* remember postamble byte number *)
	pstptr:=dvibytecnt;
	if printing then begin
		write('PST (at byte '); writeint(pstptr); writeln(')');	end;

	(* handle previous page pointer *)
	checkpageptr:=intin;
	if printing then begin
		write(tab,'final page pointer: ');
		writeint(checkpageptr);
		writeln; end;
	if (not halfpass) and (checkpageptr<>lastpageptr) then 
		error(3,lastpageptr);

	(* handle internal unit spec *)
	multiplier:=intin; divider:=intin;
	if printing then begin
		write(tab,'Multiplier '); writeint(multiplier);
		write(tab,'Divider '); writeint(divider);
		writeln; end;
	if multiplier<=0 then begin error(22,multiplier); multiplier:=1; end;
	if divider<=0 then begin error(23,divider); divider:=1; end;

	(* handle magnification *)
	if printing then write(tab,'overall magnification: ');
	magnify:=intin; 
	if printing then begin
		writeint(magnify);
		if (overridemag>0) and secondpass then begin
			write(' (overridden to ');
			writeint(overridemag);
			write(')');
			end;
		writeln;
		end;

	(* handle max height and width *)
	if printing then write(tab,'maximum page height: ');
	maxh:=fourbytes;
	if printing then begin
		writedimen(maxh); writeln;
		write(tab,'maximum page width: '); end;
	maxw:=fourbytes;
	if printing then begin writedimen(maxw); writeln; end;

	(* do all font definitions *)
	id:=intin;
	while id>-1 do begin (* -1 flags end of font defs *)
		(* read a font definition *)
		if printing then begin 
			write(tab,'font '); writeint(id); end;
		if (id>MAXF) or (id<0) then begin error(2,id); id:=0; end;

		(* font checksum *)
		if printing then write(' cksum: ');
		cksum:=intin;
		if printing then writeoct(cksum);

		(* font magnification *)
		if printing then write(' mag: ');
		fontmag[id]:=intin;
		if printing then writeint(fontmag[id]);

		(* font name *)
		if printing then write(' name: ');
		namelen:=getb;
		if namelen>MAXSTRLEN then begin
			error(26,namelen);
			extralen:=namelen-MAXSTRLEN;
			namelen:=MAXSTRLEN;
			end
		else extralen:=0;
		fontname[id].len:=namelen;
		for i:=1 to namelen do fontname[id].let[i]:=asciiin;
		if extralen>0 then begin
			write(' (dropped from font name:''');
			for i:=1 to extralen do writechr(asciiin);
			writeln(''')');
			end;

		if printing then begin
			writestr(fontname[id]);
			if (not fontused[id]) and (not halfpass)
				then write(' (never used)');
			writeln;
			end;

		(* check if it's multiply defined *)
		if firstpass and fontdefined[id] then error(5,id);
		fontdefined[id]:=true;

		id:=intin; (* for next time around *)
		end;

	(* check to see that all fonts appearing in a FONT or FONTNUM
				command actually appeared in the postamble *)
	for i:=0 to MAXF do
		if fontused[i] and not fontdefined[i] then error(4,i);


	(* finish printing the postamble *)

	(* do postamble back pointer *)
	if printing then write(tab,'Postamble back pointer: ');
	checkpageptr:=intin; 
	if printing then begin writeint(checkpageptr); writeln; end;
	if checkpageptr<>pstptr then error(7,pstptr);

	(* do id byte *)
	if printing then write(tab,'DVI ID byte: ');
	idbyte:=getb;
	if printing then begin writeint(idbyte); writeln; end;
	if idbyte<>DVIID then error(10,idbyte);

	(* do 223 bytes after id byte *)
	if printing then write('Bytes after postamble:');
	eofok:=true;
	junkbyte:=getb;
	while junkbyte>-1 do begin 
		if printing then begin write(' '); writeint(junkbyte); end;
		if junkbyte<>223 then error(8,junkbyte);
		junkbyte:=getb; (* for next time around *)
		end;
	if printing then writeln;
	end;


(* initialize strings, and the font arrays *)
procedure initialize;
	begin

	fontarea.let[1]:=ord('<'); fontarea.let[2]:=ord('T');
	fontarea.let[3]:=ord('E'); fontarea.let[4]:=ord('X');
	fontarea.let[5]:=ord('.'); fontarea.let[6]:=ord('F');
	fontarea.let[7]:=ord('O'); fontarea.let[8]:=ord('N');
	fontarea.let[9]:=ord('T'); fontarea.let[10]:=ord('S');
	fontarea.let[11]:=ord('>');fontarea.len:=11;

	fontext.let[1]:=ord('.'); fontext.let[2]:=ord('T');
	fontext.let[3]:=ord('F'); fontext.let[4]:=ord('M'); fontext.len:=4;

	meter.let[1]:=ord('m'); meter.len:=1;
	cm.let[1]:=ord('c'); cm.let[2]:=ord('m'); cm.len:=2;
	pt.let[1]:=ord('p'); pt.let[2]:=ord('t'); pt.len:=2;
	inch.let[1]:=ord('i'); inch.let[2]:=ord('n');  inch.len:=2;
	rsu.let[1]:=ord('r'); rsu.let[2]:=ord('s'); rsu.let[3]:=ord('u'); 
	rsu.len:=3;

	for i:=0 to MAXF do begin
		fontused[i]:=false;
		fontdefined[i]:=false;
		fontname[i].len:=0;
		widthloaded[i]:=false;
		end;

	end;

(* And here we go...main program *)
begin

initialize;

(* Set up output file *)
rewrite(output);

(* Find out in what units the user wants the results printed *)
repeat
	writeln(tty,'Units? (0=RSUs, 1=meters, 2=cm, 3=inches, 4=points) ');
(*foo*) break(tty);
	read(tty,i);
	if (i>-1) and (i<5) then 
		case i of
		0: begin convert:=1.0; units:=rsu; dp:=0 end;
		1: begin convert:=0.0000001; units:=meter; dp:=3 end;
		2: begin convert:=0.00001; units:=cm; dp:=2 end;
		3: begin convert:=0.00001/2.54; units:=inch; dp:=3 end;
		4: begin convert:=72.27/254000; units:=pt; dp:=2 end;
	end 
until (i>-1) and (i<5);

(* See if user wants two pass or half pass or one pass *)
repeat writeln(tty,'How many passes? (1/2) '); (*foo*) break(tty); read(tty,i);
until (i=1) or (i=2);	

if i=2 then begin

	(* two pass operation *)
	twopass:=true;

	(* get second pass magnification override *)
	repeat
		writeln(tty,'Second pass magnification? ',
			'(0 for default from postamble) ');
		(*foo*)break(tty);
		read(tty,overridemag);
	until (overridemag>=0) and (overridemag<100000);

	(* see if uset wants to print the first pass *)
	repeat writeln(tty,'Print first pass? (0/1) '); (*foo*)break(tty); read(tty,i);
	until (i=0) or (i=1);
	if i>0 then printing:=true else printing:=false;

	(* see if user wants terse second pass printing *)
	repeat writeln(tty,'Terse second pass? (0/1) '); (*foo*)break(tty); read(tty,i);
	until (i=1) or (i=0);
	if i>0 then terse:=true else terse:=false;

	(* see if user wants a short first pass *)
(*foo	repeat writeln(tty,'Jump to postamble? (0/1) '); read(tty,i);
	until (i=0) or (i=1);
foo*)i:=0;

	if i>0 then begin
		(* short first pass *)
		halfpass:=true; firstpass:=true; secondpass:=false;
		writeln(tty,'Start quick first pass.');

		(* figure out where the postamble is *)
		reset(dvi);
		dvilen:=dvibytes;
		pstptr:=dvilen-1; (* will be backed up until correct below *)
		if printing then begin
			write('DVI file has '); writeint(dvilen);
			write(' bytes (numbered 0 to '); writeint(pstptr);
			writeln(').');
			writeln('Looking at last byte in DVI file.');
			end;
		rand(pstptr);
		junkbyte:=getb;
		if junkbyte<>223 then error(9,junkbyte);
		if printing then writeln('Looking backwards for DVI ID byte:');
		repeat
			pstptr:=pstptr-1;
			if printing then writeln(tab,'Byte number ',
							pstptr:plen(pstptr));
			rand(pstptr);
			idbyte:=getb;
			if (idbyte<>223) and (idbyte<>DVIID) then
							 error(9,idbyte);
		until idbyte=DVIID;
		if printing then 
			writeln('Got DVI ID, now get postamble backpointer.');
		pstptr:=pstptr-4;
		rand(pstptr);
		pstptr:=intin; (* now pstptr is finally what it claims to be *)
		if printing then writeln('Postamble backpointer says that the',
			' PST is in byte number ',pstptr:plen(pstptr),'.');
		if pstptr>=dvilen then error(-28,pstptr);
		rand(pstptr);
		junkbyte:=getb;
		if junkbyte <> PST then error(-11,junkbyte);
		if printing then writeln('Reading Postamble.');
		readpostamble;
		secondpass:=true; firstpass:=false; halfpass:=false;
		writeln(tty,'Finished quick first pass.');
		end

	else begin
		(* set up for first pass of two full passes *)
		halfpass:=false; firstpass:=true; secondpass:=false;
		end;
	end
else begin
	(* just one pass *)
	twopass:=false;
	printing:=true; halfpass:=false; firstpass:=true; secondpass:=false;
	end;

1: (* come back here to start a new pass *)

write(tty,'Starting pass ');
if firstpass then
	 writeln(tty,'one.');
(* I'm leaving out the ELSE here to prove that secondpass = (not firstpass) *)
if secondpass then begin
	writeln(tty,'two.');
	(* figure out the second pass magnification *)
	if overridemag<>0 then magnify:=overridemag;
	write('Second pass magnification is ');	writeint(magnify); writeln;

	(* and how to convert from RSUs to UNITs *)
	convert:=convert*(magnify/1000)*(multiplier/divider);

	if terse then printing:=false else printing:=true;
	end;
(*foo*)break(tty);
reset(dvi); (* (go back and) read the DVI file from the beginning *)

top:=0; 	(* stack is empty *)
f:=-1;		(* there is no current font *)
h:=0; v:=0;	(* 'current position on page'=(0,0) *)

expectbop:=true;	(* first command in DVI file must be BOP *)
dvibytecnt:=-1;		(* first byte is zeroth, but GETB increments first *)
lastpageptr:=-1;	(* check first page's previous page pointer *)
eofok:=false;		(* not ok to find end of DVI file *)

foundpst:=false;	(* keep doing this loop until foundpst=true *)
repeat
	dvicmd:=getb ; (* dvicmd gets the next command in the DVI file *)

	if printing then writeln;

	(* skip over NOPs *)
	if dvicmd=NOP then begin
		repeat 
			if printing then write('NOP ');
			dvicmd:=getb
		until dvicmd<>NOP;
		if printing then writeln;
		end;

	(* check if we are expecting a BOP *)
	if expectbop and (dvicmd<>BOP) and (dvicmd<>PST) then
		if dvibytecnt>0 then error(12,dvicmd)
		else error(21,dvicmd);
	expectbop:=false;

	if printing and secondpass then begin writeat; writeln; end;

	if dvicmd>217 then error(20,dvicmd)

	else if dvicmd<=127 then begin
		(* its a VERTCHAR *)
		if printing then begin 
			write('VERTCHAR'); writeint(dvicmd); end;

		(* print 'cpop' if needed *)
		if secondpass and terse then writeat;

		(* handle font number *)
		if printing or (secondpass and terse) then begin
			write(' (font '); writeint(f); end;
		if f<0 then begin error(13,dvicmd); f:=0; end;

		(* handle character name/number *)
		if printing or (secondpass and terse) then begin
			write(' char '); writechr(dvicmd); write(')'); end;

		(* handle character's width *)
		if secondpass then begin
			width:=charwidth[f,dvicmd];
			if printing then begin
				write(' (width=');
				writedimen(width);
				write(')'); end;
			h:=h+width;
			if terse then writeln;
			end;
		end

	else if (FONTNUM<=dvicmd) and (dvicmd<=FONTNUM+63) then begin
		(* its a FONTNUM *)
		if printing then write('FONTNUM');
		touchfont(dvicmd-FONTNUM);
		end

	else case dvicmd of

	BOP: begin
		h:=0; v:=0; wamt:=0; xamt:=0; yamt:=0; zamt:=0;
		f:=-1;		(* to check for font command preceeding
					any HORZ/VERT CHAR on this page *)

		thispageptr:=dvibytecnt;
				(* to check next page's previous page ptr *)

		(* handle the count paramaters *)
		if printing then begin
			write('BOP (at byte '); writeint(thispageptr); 
			writeln(')'); write(tab); end;
		for i:=0 to 4 do begin
			if printing then begin
				write('\count'); writeint(i); write('='); end;
			kount[i]:=intin;
			if printing then begin 
				writeint(kount[i]); write(' '); end;
			end;
		if printing then begin writeln; write(tab); end;
		for i:=5 to 9 do begin
			if printing then begin
				write('\count'); writeint(i); write('='); end;
			kount[i]:=intin;
			if printing then begin
				writeint(kount[i]); write(' '); end;
			end;

		(* handle previous page pointer paramater *)
		if printing then begin
			writeln; write(tab,'previous page at byte '); end;
		checkpageptr:=intin; 
		if printing then writeint(checkpageptr);
		if checkpageptr<>lastpageptr then error(14,lastpageptr);
		end;

	EOP: begin
		if printing then write('EOP');
		if top>0 then begin error(15,top); top:=0; end;
		expectbop:=true;	(* BOP or PST must be next command *)
		lastpageptr:=thispageptr;
				(* help check next page's prevpagepointer *)
		end;

	VERTRULE: begin
		height:=fourbytes;
		width:=fourbytes;
		if printing or (secondpass and terse) then begin
			if secondpass and terse then begin
				writeat; write(' (rule height '); end
			else write('VERTRULE height=');
			writedimen(height);
			write(', width='); writedimen(width);
			if secondpass and terse then writeln(')');
			end;
		if secondpass then h:=h+width;
		end;

	HORZRULE: begin
		height:=fourbytes;
		width:=fourbytes;
		if printing or (secondpass and terse) then begin
			if secondpass and terse then begin
				writeat; write(' (rule height '); end
			else write('HORZRULE height ');
			writedimen(height);
			write(', width '); writedimen(width);
			if secondpass and terse then writeln(')');
			end;
		end;

	HORZCHAR: begin
		if printing then write('HORZCHAR ');
		charno:=getb;
		if printing then writeint(charno);
		if charno>127 then begin error(16,charno); charno:=127; end;
		if printing or (secondpass and terse) then begin
			if secondpass and terse then writeat;
			write(' (font '); writeint(f);
			write(' char '); writechr(charno);
			write(')');
			if secondpass and terse then writeln;
			end;
		if f<0 then begin error(17,charno); f:=0; end;
		end;

	FONT: begin 
		if printing then write('FONT ');
		touchfont(intin);
		end;

	PUSH: begin
		if printing then begin
			write('PUSH (to level '); writeint(top); write(')');
			end;
		if top>=MAXS then error(18,MAXS)
		else begin
			(* stack everything up *)
			top:=top+1; 
			wstack[top]:=wamt; xstack[top]:=xamt;
			ystack[top]:=yamt; zstack[top]:=zamt;
			hstack[top]:=h; vstack[top]:=v;
			end;
		end;

	POP: begin
		if printing then begin
			write('POP (from level '); writeint(top); write(')');
			end;
		if top=0 then error(19,kount[0])
		else begin
			(* pop the stack *)
			wamt:=wstack[top]; xamt:=xstack[top];
			yamt:=ystack[top]; zamt:=zstack[top];
			h:=hstack[top]; v:=vstack[top];
			top:=top-1;
			end;
		end;

	W0: wmove(0,wamt);
	W2: wmove(2,twobytes);
	W3: wmove(3,threebytes);
	W4: wmove(4,fourbytes);

	X0: xmove(0,xamt);
	X2: xmove(2,twobytes);
	X3: xmove(3,threebytes);
	X4: xmove(4,fourbytes);

	Y0: ymove(0,yamt);
	Y2: ymove(2,twobytes);
	Y3: ymove(3,threebytes);
	Y4: ymove(4,fourbytes);

	Z0: zmove(0,zamt);
	Z2: zmove(2,twobytes);
	Z3: zmove(3,threebytes);
	Z4: zmove(4,fourbytes);

	PST: begin 
		readpostamble;
		foundpst:=true; (* to stop this loop *)
		end;

	end ; (* of case statement  *)

until foundpst;

(*foo*)break(output);
write(tty,'Finished pass ');
if firstpass then writeln(tty,'one.');
if secondpass then writeln(tty,'two.');
(*foo*)break(tty);

(* ok, we've been through a(nother) whole pass.  Should we do another? *)
if twopass and firstpass then begin
	secondpass:=true; firstpass:=false;
	goto 1;
	end;

9: (* go here to end execution *)
end.